!-------------------------------------------------------------LICENSE--------------------------------------------------------------!
!                                                                                                                                  !
!The MAP code is written in Fortran language for magnetohydrodynamics (MHD) calculation with the adaptive mesh refinement (AMR)    !
!and Message Passing Interface (MPI) parallelization.                                                                              !
!                                                                                                                                  !
!Copyright (C) 2012                                                                                                                !
!Ronglin Jiang                                                                                                                     !
!rljiang@ssc.net.cn                                                                                                                !
!585 Guoshoujing Road. Pudong, Shanghai, P.R.C. 201203                                                                             !
!                                                                                                                                  !
!This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License         !
!as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version.             !
!                                                                                                                                  !
!This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of    !
!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more details.                        !
!                                                                                                                                  !
!You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software     !
!Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.                                                   !
!                                                                                                                                  !
!-------------------------------------------------------------LICENSE--------------------------------------------------------------!

!==================================================================================================================================|
subroutine block_exchange(current, dir, ro_flag, mx_flag, my_flag, mz_flag, bx_flag, by_flag, bz_flag, en_flag, po_flag, fix_flag)
!==================================================================================================================================|

   use parameters
   use block_define
   use interface_block_boundary_physi
   implicit none

   character(1), intent(in) :: dir
   logical(4), optional :: ro_flag, mx_flag, my_flag, mz_flag, bx_flag, by_flag, bz_flag, en_flag, po_flag, fix_flag
   type(block), pointer, intent(in) :: current

   integer(4) :: level, i_n, j_n, k_n, i_c, j_c, k_c, i_neigh, j_neigh, k_neigh !, i_neigh_x
   integer(4) :: nx_tmp, ny_tmp, nz_tmp
   logical(4) :: data_exchange_flag !, fix_data_flag

   type(block), pointer :: neigh !, neigh_x

!----------------------------------------------------------------------------------------------------------------------------------|
   level = current%lv

   if (dir .eq. 'x') then
!----------------------------------------------------------------------------------------------------------------------------------|
!     left boundary
!----------------------------------------------------------------------------------------------------------------------------------|
      i_neigh = -1
      j_neigh = 0
      k_neigh = 0
      neigh => current%neigh(i_neigh, j_neigh, k_neigh)%pblock
      if (associated(neigh)) then
         if (neigh%lv .eq. level .and. neigh%cpu_id .eq. cpu_id) then
            nx_tmp = nx_no_bnd
            do k = 1, nz_no_bnd
               k_n = k + ng
               do j = 1, ny_no_bnd
                  j_n = j + ng
                  do i = 1, ng
                     i_n = nx_tmp + i
                     if (present(ro_flag)) current%ro(i, j_n, k_n) = neigh%ro(i_n, j_n, k_n)
                     if (present(mx_flag)) current%mx(i, j_n, k_n) = neigh%mx(i_n, j_n, k_n)
                     if (present(my_flag)) current%my(i, j_n, k_n) = neigh%my(i_n, j_n, k_n)
                     if (present(mz_flag)) current%mz(i, j_n, k_n) = neigh%mz(i_n, j_n, k_n)
                     if (present(bx_flag)) current%bx(i, j_n, k_n) = neigh%bx(i_n, j_n, k_n)
                     if (present(by_flag)) current%by(i, j_n, k_n) = neigh%by(i_n, j_n, k_n)
                     if (present(bz_flag)) current%bz(i, j_n, k_n) = neigh%bz(i_n, j_n, k_n)
                     if (present(en_flag)) current%en(i, j_n, k_n) = neigh%en(i_n, j_n, k_n)
                     if (present(po_flag)) current%po(i, j_n, k_n) = neigh%po(i_n, j_n, k_n)
                  enddo
               enddo
            enddo
         elseif (neigh%lv .lt. 0) then
            call block_boundary_physi (current, dir, 'l', 'i',                                                                     &
               present(ro_flag), present(mx_flag), present(my_flag), present(mz_flag),                                             &
               present(bx_flag), present(by_flag), present(bz_flag), present(en_flag), present(po_flag), abs(neigh%lv))
         endif
      else
         call block_boundary_physi (current, dir, 'l', 'e',                                                                        &
            present(ro_flag), present(mx_flag), present(my_flag), present(mz_flag),                                                &
            present(bx_flag), present(by_flag), present(bz_flag), present(en_flag), present(po_flag))
      endif

!----------------------------------------------------------------------------------------------------------------------------------|
!     right boundary
!----------------------------------------------------------------------------------------------------------------------------------|
      i_neigh = 1
      j_neigh = 0
      k_neigh = 0
      neigh => current%neigh(i_neigh, j_neigh, k_neigh)%pblock
      if (associated(neigh)) then
         if (neigh%lv .eq. level .and. neigh%cpu_id .eq. cpu_id) then
            nx_tmp = nx_block - ng
            do k = 1, nz_no_bnd
               k_n = k + ng
               do j = 1, ny_no_bnd
                  j_n = j + ng
                  do i = 1, ng
                     i_c = nx_tmp + i
                     i_n = ng + i
                     if (present(ro_flag)) current%ro(i_c, j_n, k_n) = neigh%ro(i_n, j_n, k_n)
                     if (present(mx_flag)) current%mx(i_c, j_n, k_n) = neigh%mx(i_n, j_n, k_n)
                     if (present(my_flag)) current%my(i_c, j_n, k_n) = neigh%my(i_n, j_n, k_n)
                     if (present(mz_flag)) current%mz(i_c, j_n, k_n) = neigh%mz(i_n, j_n, k_n)
                     if (present(bx_flag)) current%bx(i_c, j_n, k_n) = neigh%bx(i_n, j_n, k_n)
                     if (present(by_flag)) current%by(i_c, j_n, k_n) = neigh%by(i_n, j_n, k_n)
                     if (present(bz_flag)) current%bz(i_c, j_n, k_n) = neigh%bz(i_n, j_n, k_n)
                     if (present(en_flag)) current%en(i_c, j_n, k_n) = neigh%en(i_n, j_n, k_n)
                     if (present(po_flag)) current%po(i_c, j_n, k_n) = neigh%po(i_n, j_n, k_n)
                  enddo
               enddo
            enddo
         elseif (neigh%lv .lt. 0) then
            call block_boundary_physi (current, dir, 'h', 'i',                                                                     &
               present(ro_flag), present(mx_flag), present(my_flag), present(mz_flag),                                             &
               present(bx_flag), present(by_flag), present(bz_flag), present(en_flag), present(po_flag), abs(neigh%lv))
         endif
      else
         call block_boundary_physi (current, dir, 'h', 'e',                                                                        &
            present(ro_flag), present(mx_flag), present(my_flag), present(mz_flag),                                                &
            present(bx_flag), present(by_flag), present(bz_flag), present(en_flag), present(po_flag))
      endif
   endif

   if (dir .eq. 'y') then
!----------------------------------------------------------------------------------------------------------------------------------|
!     behind boundary
!----------------------------------------------------------------------------------------------------------------------------------|
      i_neigh = 0
      j_neigh = -1
      k_neigh = 0
      neigh => current%neigh(i_neigh, j_neigh, k_neigh)%pblock
      if (associated(neigh)) then
         if (neigh%lv .eq. level .and. neigh%cpu_id .eq. cpu_id) then

            data_exchange_flag = .true.
            if (present(fix_flag)) data_exchange_flag = .true.
!            if (present(fix_flag)) then
!               fix_data_flag = .false.
!               do i_neigh_x = -1, 1, 2
!                  neigh_x => current%neigh(i_neigh_x, -1)%pblock
!                  if (associated(neigh_x)) then
!                     if (neigh_x%lv .eq. current%lv - 1) fix_data_flag = .true.
!                  endif
!               enddo
!               if (.not. fix_data_flag) data_exchange_flag = .false.
!            endif

            if (data_exchange_flag) then
               ny_tmp = ny_no_bnd
               do k = 1, nz_no_bnd
                  k_n = k + ng
                  do j = 1, ng
                     j_n = ny_tmp + j
                     do i = 1, nx_block
                        if (present(ro_flag)) current%ro(i, j, k_n) = neigh%ro(i, j_n, k_n)
                        if (present(mx_flag)) current%mx(i, j, k_n) = neigh%mx(i, j_n, k_n)
                        if (present(my_flag)) current%my(i, j, k_n) = neigh%my(i, j_n, k_n)
                        if (present(mz_flag)) current%mz(i, j, k_n) = neigh%mz(i, j_n, k_n)
                        if (present(bx_flag)) current%bx(i, j, k_n) = neigh%bx(i, j_n, k_n)
                        if (present(by_flag)) current%by(i, j, k_n) = neigh%by(i, j_n, k_n)
                        if (present(bz_flag)) current%bz(i, j, k_n) = neigh%bz(i, j_n, k_n)
                        if (present(en_flag)) current%en(i, j, k_n) = neigh%en(i, j_n, k_n)
                        if (present(po_flag)) current%po(i, j, k_n) = neigh%po(i, j_n, k_n)
                     enddo
                  enddo
               enddo
            endif
         elseif (neigh%lv .lt. 0) then
            call block_boundary_physi (current, dir, 'l', 'i',                                                                     &
               present(ro_flag), present(mx_flag), present(my_flag), present(mz_flag),                                             &
               present(bx_flag), present(by_flag), present(bz_flag), present(en_flag), present(po_flag), abs(neigh%lv))
         endif
      else
         call block_boundary_physi (current, dir, 'l', 'e',                                                                        &
            present(ro_flag), present(mx_flag), present(my_flag), present(mz_flag),                                                &
            present(bx_flag), present(by_flag), present(bz_flag), present(en_flag), present(po_flag))
      endif

!----------------------------------------------------------------------------------------------------------------------------------|
!     front boundary
!----------------------------------------------------------------------------------------------------------------------------------|
      i_neigh = 0
      j_neigh = 1
      k_neigh = 0
      neigh => current%neigh(i_neigh, j_neigh, k_neigh)%pblock
      if (associated(neigh)) then
         if (neigh%lv .eq. level .and. neigh%cpu_id .eq. cpu_id) then

            data_exchange_flag = .true.
!            if (present(fix_flag)) then
!               fix_data_flag = .false.
!               do i_neigh_x = -1, 1, 2
!                  neigh_x => current%neigh(i_neigh_x, 1)%pblock
!                  if (associated(neigh_x)) then
!                     if (neigh_x%lv .eq. current%lv - 1) fix_data_flag = .true.
!                  endif
!               enddo
!               if (.not. fix_data_flag) data_exchange_flag = .false.
!            endif

            if (data_exchange_flag) then
               ny_tmp = ny_block - ng
               do k = 1, nz_no_bnd
                  k_n = k + ng
                  do j = 1, ng
                     j_c = ny_tmp + j
                     j_n = ng + j
                     do i = 1, nx_block
                        if (present(ro_flag)) current%ro(i, j_c, k_n) = neigh%ro(i, j_n, k_n)
                        if (present(mx_flag)) current%mx(i, j_c, k_n) = neigh%mx(i, j_n, k_n)
                        if (present(my_flag)) current%my(i, j_c, k_n) = neigh%my(i, j_n, k_n)
                        if (present(mz_flag)) current%mz(i, j_c, k_n) = neigh%mz(i, j_n, k_n)
                        if (present(bx_flag)) current%bx(i, j_c, k_n) = neigh%bx(i, j_n, k_n)
                        if (present(by_flag)) current%by(i, j_c, k_n) = neigh%by(i, j_n, k_n)
                        if (present(bz_flag)) current%bz(i, j_c, k_n) = neigh%bz(i, j_n, k_n)
                        if (present(en_flag)) current%en(i, j_c, k_n) = neigh%en(i, j_n, k_n)
                        if (present(po_flag)) current%po(i, j_c, k_n) = neigh%po(i, j_n, k_n)
                     enddo
                  enddo
               enddo
            endif
         elseif (neigh%lv .lt. 0) then
            call block_boundary_physi (current, dir, 'h', 'i',                                                                     &
               present(ro_flag), present(mx_flag), present(my_flag), present(mz_flag),                                             &
               present(bx_flag), present(by_flag), present(bz_flag), present(en_flag), present(po_flag), abs(neigh%lv))
         endif
      else
         call block_boundary_physi (current, dir, 'h', 'e',                                                                        &
            present(ro_flag), present(mx_flag), present(my_flag), present(mz_flag),                                                &
            present(bx_flag), present(by_flag), present(bz_flag), present(en_flag), present(po_flag))
      endif
   endif

   if (dir .eq. 'z') then
!----------------------------------------------------------------------------------------------------------------------------------|
!     bottom boundary
!----------------------------------------------------------------------------------------------------------------------------------|
      i_neigh = 0
      j_neigh = 0
      k_neigh = -1
      neigh => current%neigh(i_neigh, j_neigh, k_neigh)%pblock
      if (associated(neigh)) then
         if (neigh%lv .eq. level .and. neigh%cpu_id .eq. cpu_id) then

            data_exchange_flag = .true.
!            if (present(fix_flag)) then
!               fix_data_flag = .false.
!               do i_neigh_x = -1, 1, 2
!                  neigh_x => current%neigh(i_neigh_x, -1)%pblock
!                  if (associated(neigh_x)) then
!                     if (neigh_x%lv .eq. current%lv - 1) fix_data_flag = .true.
!                  endif
!               enddo
!               if (.not. fix_data_flag) data_exchange_flag = .false.
!            endif

            if (data_exchange_flag) then
               nz_tmp = nz_no_bnd
               do k = 1, ng
                  k_n = nz_tmp + k
                  do j = 1, ny_block
                  do i = 1, nx_block
                     if (present(ro_flag)) current%ro(i, j, k) = neigh%ro(i, j, k_n)
                     if (present(mx_flag)) current%mx(i, j, k) = neigh%mx(i, j, k_n)
                     if (present(my_flag)) current%my(i, j, k) = neigh%my(i, j, k_n)
                     if (present(mz_flag)) current%mz(i, j, k) = neigh%mz(i, j, k_n)
                     if (present(bx_flag)) current%bx(i, j, k) = neigh%bx(i, j, k_n)
                     if (present(by_flag)) current%by(i, j, k) = neigh%by(i, j, k_n)
                     if (present(bz_flag)) current%bz(i, j, k) = neigh%bz(i, j, k_n)
                     if (present(en_flag)) current%en(i, j, k) = neigh%en(i, j, k_n)
                     if (present(po_flag)) current%po(i, j, k) = neigh%po(i, j, k_n)
                  enddo
                  enddo
               enddo
            endif
         elseif (neigh%lv .lt. 0) then
            call block_boundary_physi (current, dir, 'l', 'i',                                                                     &
               present(ro_flag), present(mx_flag), present(my_flag), present(mz_flag),                                             &
               present(bx_flag), present(by_flag), present(bz_flag), present(en_flag), present(po_flag), abs(neigh%lv))
         endif
      else
         call block_boundary_physi (current, dir, 'l', 'e',                                                                        &
            present(ro_flag), present(mx_flag), present(my_flag), present(mz_flag),                                                &
            present(bx_flag), present(by_flag), present(bz_flag), present(en_flag), present(po_flag))
      endif

!----------------------------------------------------------------------------------------------------------------------------------|
!     top boundary
!----------------------------------------------------------------------------------------------------------------------------------|
      i_neigh = 0
      j_neigh = 0
      k_neigh = 1
      neigh => current%neigh(i_neigh, j_neigh, k_neigh)%pblock
      if (associated(neigh)) then
         if (neigh%lv .eq. level .and. neigh%cpu_id .eq. cpu_id) then

            data_exchange_flag = .true.
!            if (present(fix_flag)) then
!               fix_data_flag = .false.
!               do i_neigh_x = -1, 1, 2
!                  neigh_x => current%neigh(i_neigh_x, 1)%pblock
!                  if (associated(neigh_x)) then
!                     if (neigh_x%lv .eq. current%lv - 1) fix_data_flag = .true.
!                  endif
!               enddo
!               if (.not. fix_data_flag) data_exchange_flag = .false.
!            endif

            if (data_exchange_flag) then
               nz_tmp = nz_block - ng
               do k = 1, ng
                  k_c = nz_tmp + k
                  k_n = k + ng
                  do j = 1, ny_block
                  do i = 1, nx_block
                     if (present(ro_flag)) current%ro(i, j, k_c) = neigh%ro(i, j, k_n)
                     if (present(mx_flag)) current%mx(i, j, k_c) = neigh%mx(i, j, k_n)
                     if (present(my_flag)) current%my(i, j, k_c) = neigh%my(i, j, k_n)
                     if (present(mz_flag)) current%mz(i, j, k_c) = neigh%mz(i, j, k_n)
                     if (present(bx_flag)) current%bx(i, j, k_c) = neigh%bx(i, j, k_n)
                     if (present(by_flag)) current%by(i, j, k_c) = neigh%by(i, j, k_n)
                     if (present(bz_flag)) current%bz(i, j, k_c) = neigh%bz(i, j, k_n)
                     if (present(en_flag)) current%en(i, j, k_c) = neigh%en(i, j, k_n)
                     if (present(po_flag)) current%po(i, j, k_c) = neigh%po(i, j, k_n)
                  enddo
                  enddo
               enddo
            endif
         elseif (neigh%lv .lt. 0) then
            call block_boundary_physi (current, dir, 'h', 'i',                                                                     &
               present(ro_flag), present(mx_flag), present(my_flag), present(mz_flag),                                             &
               present(bx_flag), present(by_flag), present(bz_flag), present(en_flag), present(po_flag), abs(neigh%lv))
         endif
      else
         call block_boundary_physi (current, dir, 'h', 'e',                                                                        &
            present(ro_flag), present(mx_flag), present(my_flag), present(mz_flag),                                                &
            present(bx_flag), present(by_flag), present(bz_flag), present(en_flag), present(po_flag))
      endif
   endif

!----------------------------------------------------------------------------------------------------------------------------------|
   return
end subroutine block_exchange
